-- Assignment 3
-- Indication of time spent: 7 man hours
--
-- There are usually two ways to test something: compare the implementation with
-- another possible implementation, or looking at properties. In some test cases
-- (like domain, range, symmetry) we were unable to use the latter approach, so
-- we had to use the first one.
-- Another problem with using property-based testing is that this usually leaves
-- gaps in the tests. This does not happen with implementation-based testing, but
-- in these cases the test itself is more likely to contain errors.

module TestREL

where

import List
import Test.SmallCheck
import REL
import SetOrd

main :: IO ()
main = do
  depthCheck 3 prop_domain
  depthCheck 3 prop_range
  depthCheck 3 prop_id
  depthCheck 3 prop_total
  depthCheck 3 prop_inverse
  depthCheck 3 prop_in
  depthCheck 3 prop_complement
  depthCheck 3 prop_reflexive
  depthCheck 3 prop_irreflexive
  depthCheck 3 prop_symmetry
  depthCheck 3 prop_transitive
  
prop_domain :: [(Int,Int)] -> Bool
prop_domain r = null [x | (x,y) <- r, not (inSet x (domR (toRel r)))]

prop_range :: [(Int,Int)] -> Bool
prop_range r = null [y | (x,y) <- r, not (inSet y (ranR (toRel r)))]

prop_id :: [Int] -> Bool
prop_id r = domR (idR (list2set r)) == ranR (idR (list2set r))

prop_total :: [Int] -> Bool
prop_total r = sizeR (totalR (list2set r)) == square (length (nub r))
  where
    square :: Int -> Int
    square x = x ^ 2

prop_inverse :: [(Int,Int)] -> Bool
prop_inverse r = domR (toRel r) == ranR (invR (toRel r)) &&
                 ranR (toRel r) == domR (invR (toRel r))

prop_in :: [(Int,Int)] -> Bool
prop_in [] = True
prop_in r = [(x,y) | (x,y) <- r, inR (toRel r) (x,y)] == r

prop_complement :: [Int] -> [(Int,Int)] -> Bool
prop_complement s r = null [(x,y) | (x,y) <- r, inR (complR (list2set s) (toRel r)) (x,y)]

prop_reflexive :: [Int] -> [(Int,Int)] -> Bool
prop_reflexive s r = reflR (list2set s) (toRel r) == elems (duplicate s) r
  where
    duplicate :: [a] -> [(a,a)]
    duplicate source = [(x,x) | x <- source]
    elems :: [(Int,Int)] -> [(Int,Int)] -> Bool
    elems [] haystack = True
    elems needles haystack = elem (head needles) haystack && elems (tail needles) haystack

prop_irreflexive :: [Int] -> Bool
prop_irreflexive [] = True
prop_irreflexive s = not (irreflR (list2set s) (idR (list2set s)))
                       
prop_symmetry :: [(Int,Int)] -> Bool
prop_symmetry [] = True
prop_symmetry r = symR (toRel r) == null [(x,y) | (x,y) <- r, not (elem (y,x) r)]

prop_transitive :: [(Int,Int)] -> Bool
prop_transitive r = if length (symbols (toRel r)) >= 3 && transR (toRel r)
                    then allIn (takeThree (symbols (toRel r))) r
                    else True
  where
    allIn :: (Int,Int,Int) -> [(Int,Int)] -> Bool
    allIn (a,b,c) r = if elem (a,b) r && elem (b,c) r
                      then elem (a,c) r
                      else True
    takeThree :: [Int] -> (Int,Int,Int)
    takeThree r = (r !! 0,r !! 1,r !! 2)
    
-- Convenience methods

toRel :: [(Int,Int)] -> Rel Int
toRel x = list2set x

toList :: Set a -> [a]
toList (Set x) = x

size :: Set a -> Int
size (Set s) = length s

sizeR :: Set (a,a) -> Int
sizeR r = size r

symbols :: Rel Int -> [Int]
symbols r = nub (toList (domR r) ++ toList (ranR r))
